home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / REQ-PROV.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-04-07  |  1.8 KB  |  52 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2.  
  3. ; Common Lisp-like Require & Provide
  4. ; Require-provide loops are permitted.  To guard against infinite recursion,
  5. ; provides should appear in a file before requires.
  6. ; The global variable *modules* gets bound to the list of modules which are
  7. ; present in memory.
  8.  
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ; make-sure-*modules*-bound
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. (defun make-sure-*modules*-bound ()
  14.   (if (not (boundp '*modules*))
  15.       (setq *modules* nil)))
  16.  
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18. ; determine-require-filename 
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20.  
  21. (defun determine-require-filename (what where)
  22.   (or where
  23.       (let ((name (string-downcase (symbol-name what)))
  24.             (ext *lisp-extension*))
  25.         (strcat name ext))))
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ; require 
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. (defun require (what &optional where)
  32.   (make-sure-*modules*-bound)
  33.   (if (not (member what *modules*))
  34.       (let ((filename (determine-require-filename what where)))
  35.         (load filename :verbose *load-verbose*)
  36.         (if (not (member what *modules*))
  37.             (progn
  38.               (princ "warning: ")
  39.               (princ filename)
  40.               (princ " failed to provide ")
  41.               (princ what)
  42.               (terpri))))))
  43.  
  44. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45. ; provide 
  46. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47.  
  48. (defun provide (what)
  49.   (make-sure-*modules*-bound)
  50.   (if (not (member what *modules*))
  51.       (setq *modules* (cons what *modules*))))
  52.